rm(list=ls())
source("funcionesKickstarter.R")

En este proyecto se analizarán datos acerca de proyectos en Kicstarter; el conjunto de datos está disponible en Kaggle y consta de 378,661 registros y 19 variables que describen, fecha de inicio y final, cantidad de patrocinadores, país de origen, monto objetivo, monto logrado en moneda local y en dólares, entre otros.

El objetivo del presente proyecto es replicar algunos resultados de este artículo y responder las siguientes preguntas.

  1. ¿La longitud de la campaña afecta en la tasa de éxito?
  2. ¿Cuál es la relación entre el objetivo ($) y el éxito de la campaña?

2.1 Distribución de (monto objetivo y cantidad lograda)

Lectura y limpieza de datos

Como primer paso, se realiza la lectura de datos; además, se crean tres variables; inicio, final y duración del proyecto. En la siguiente tabla se presenta una muestra de los datos.

df0 <- read.csv("ks-projects-201801.csv") %>% 
  mutate(inicio = as.Date(launched, format = "%Y-%m-%d"),
         final = as.Date(deadline, format = "%Y-%m-%d"),
         duracion = as.numeric(final - inicio)) 
df0 %>% 
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
ID name category main_category currency deadline goal launched pledged state backers country usd.pledged usd_pledged_real usd_goal_real inicio final duracion
1000002330 The Songs of Adelaide & Abullah Poetry Publishing GBP 2015-10-09 1000 2015-08-11 12:12:28 0 failed 0 GB 0 0 1533.95 2015-08-11 2015-10-09 59
1000003930 Greeting From Earth: ZGAC Arts Capsule For ET Narrative Film Film & Video USD 2017-11-01 30000 2017-09-02 04:43:57 2421 failed 15 US 100 2421 30000.00 2017-09-02 2017-11-01 60
1000004038 Where is Hank? Narrative Film Film & Video USD 2013-02-26 45000 2013-01-12 00:20:50 220 failed 3 US 220 220 45000.00 2013-01-12 2013-02-26 45
1000007540 ToshiCapital Rekordz Needs Help to Complete Album Music Music USD 2012-04-16 5000 2012-03-17 03:24:11 1 failed 1 US 1 1 5000.00 2012-03-17 2012-04-16 30
1000011046 Community Film Project: The Art of Neighborhood Filmmaking Film & Video Film & Video USD 2015-08-29 19500 2015-07-04 08:35:03 1283 canceled 14 US 1283 1283 19500.00 2015-07-04 2015-08-29 56
1000014025 Monarch Espresso Bar Restaurants Food USD 2016-04-01 50000 2016-02-26 13:38:27 52375 successful 224 US 52375 52375 50000.00 2016-02-26 2016-04-01 35

Ahora, se obtienen estadísticos descriptivos básicos de cada variable:

summary(df0)
##        ID                 name             category         main_category     
##  Min.   :      5971   Length:378661      Length:378661      Length:378661     
##  1st Qu.: 538263516   Class :character   Class :character   Class :character  
##  Median :1075275634   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :1074731192                                                           
##  3rd Qu.:1610148624                                                           
##  Max.   :2147476221                                                           
##                                                                               
##    currency           deadline              goal             launched        
##  Length:378661      Length:378661      Min.   :        0   Length:378661     
##  Class :character   Class :character   1st Qu.:     2000   Class :character  
##  Mode  :character   Mode  :character   Median :     5200   Mode  :character  
##                                        Mean   :    49081                     
##                                        3rd Qu.:    16000                     
##                                        Max.   :100000000                     
##                                                                              
##     pledged            state              backers           country         
##  Min.   :       0   Length:378661      Min.   :     0.0   Length:378661     
##  1st Qu.:      30   Class :character   1st Qu.:     2.0   Class :character  
##  Median :     620   Mode  :character   Median :    12.0   Mode  :character  
##  Mean   :    9683                      Mean   :   105.6                     
##  3rd Qu.:    4076                      3rd Qu.:    56.0                     
##  Max.   :20338986                      Max.   :219382.0                     
##                                                                             
##   usd.pledged       usd_pledged_real   usd_goal_real           inicio          
##  Min.   :       0   Min.   :       0   Min.   :        0   Min.   :1970-01-01  
##  1st Qu.:      17   1st Qu.:      31   1st Qu.:     2000   1st Qu.:2013-05-07  
##  Median :     395   Median :     624   Median :     5500   Median :2014-12-10  
##  Mean   :    7037   Mean   :    9059   Mean   :    45454   Mean   :2014-09-28  
##  3rd Qu.:    3034   3rd Qu.:    4050   3rd Qu.:    15500   3rd Qu.:2016-03-24  
##  Max.   :20338986   Max.   :20338986   Max.   :166361391   Max.   :2018-01-02  
##  NA's   :3797                                                                  
##      final               duracion       
##  Min.   :2009-05-03   Min.   :    1.00  
##  1st Qu.:2013-06-08   1st Qu.:   30.00  
##  Median :2015-01-14   Median :   30.00  
##  Mean   :2014-11-01   Mean   :   34.48  
##  3rd Qu.:2016-04-28   3rd Qu.:   37.00  
##  Max.   :2018-03-03   Max.   :16739.00  
##

El conjunto de datos incluye información sobre 7 campañas iniciadas en 1970; considerando que el sitio Kickstarter fue fundado en 2009, esos datos se descartarán de este análisis.

El porcentaje de datos eliminados es:

100 * length(df0[which(df0$duracion > 100), 1]) / length(df0[,1])
## [1] 0.001848619

Se eliminan los registros con fecha de inicio anterior a 2009:

df <- df0 %>%
  filter(duracion <= 100)

Una de las inconsistencias detectadas es que hay campañas con 0 patrocinadores pero con monto recaudado mayor que cero; sin embargo, dado que esta variable no se utiliza en este análisis, estos datos no serán descartados.

df %>%
  filter(backers == 0, usd_pledged_real >0) %>%
  tally()
##      n
## 1 3082

Duración de la campaña y tasa de éxito

En esta parte se busca responder la siguiente pregunta: ¿La longitud de la campaña afecta en la tasa de éxito?

Según los resultados, solo el 35.4 % de las campañas logra completarse con éxito.

tabla(df$state)
vector Freq Porcentaje
canceled 38773 10.2
failed 197719 52.2
live 2799 0.7
successful 133956 35.4
suspended 1845 0.5
undefined 3562 0.9 
df %>%
  group_by(state) %>%
  tally() -> data.fig

fig <- plot_ly(
  x = data.fig$state,
  y = data.fig$n / sum(data.fig$n),
  type = "bar"
)
fig
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

Para fines de comparación con los resultados del artículo, la duración de la campaña se agrupa en los rangos:

df <- df %>%
  arrange(duracion) %>%
  mutate(rangosDuracion = case_when(
    duracion <= 7 ~ "0 a 7 días",
    duracion <= 22 ~ "08 a 22 días",
    duracion <= 37 ~ "23 a 37 días",
    duracion <= 52 ~ "38 a 52 días",
    duracion <= 67 ~ "53 a 67 días",
    duracion <= 82 ~ "68 a 82 días",
    duracion <= 93 ~ "83 a 92 días",
    TRUE ~ "Más de 92 días"))

Resumen de duración:

summary(df$duracion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     1.0    30.0    30.0    34.2    37.0    92.0

El 64.3% de campañas duró entre 23 y 37 días

tabla(df$rangosDuracion)
vector Freq Porcentaje
0 a 7 días 3308 0.9
08 a 22 días 38077 10.1
23 a 37 días 243408 64.3
38 a 52 días 48145 12.7
53 a 67 días 41779 11.0
68 a 82 días 1020 0.3
83 a 92 días 2917 0.8

Se genera una tabla de contingencia, de frecuencias, entre las variables duración (agrupada en rangos) y el estado de la campaña.

crosstab(df$state, df$rangosDuracion, Freq = TRUE)%>%
  t() %>%
  kbl() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
canceled failed live successful suspended undefined
0 a 7 días 229 1618 5 1389 42 25
08 a 22 días 2705 16083 108 18559 190 432
23 a 37 días 24398 126379 1449 87784 1040 2358
38 a 52 días 5546 25140 550 16296 242 371
53 a 67 días 5390 26319 687 8685 323 375
68 a 82 días 117 499 0 404 0 0
83 a 92 días 388 1681 0 839 8 1

Ahora, la misma tabla con porcentajes:

df.tabla <- crosstab(df$state, df$rangosDuracion, Freq = FALSE)
df.tabla %>%
  t() %>%
  kbl() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
canceled failed live successful suspended undefined
0 a 7 días 6.9 48.9 0.2 42.0 1.3 0.8
08 a 22 días 7.1 42.2 0.3 48.7 0.5 1.1
23 a 37 días 10.0 51.9 0.6 36.1 0.4 1.0
38 a 52 días 11.5 52.2 1.1 33.8 0.5 0.8
53 a 67 días 12.9 63.0 1.6 20.8 0.8 0.9
68 a 82 días 11.5 48.9 0.0 39.6 0.0 0.0
83 a 92 días 13.3 57.6 0.0 28.8 0.3 0.0

Comparación de tasa de éxito por estado

df.tabla <-df.tabla %>%
  data.frame() %>%
  filter(renglon == "successful")

fig <- plot_ly(df.tabla, x = ~columna, y = ~Freq, 
               type = 'scatter', mode = 'lines')

fig

De esta gráfica, se observa que los proyectos con duración entre 8 y 22 días tienen mayor tasa de éxito, seguida del grupo que dura 7 días o menos. Por otro lado, las campañas entre 53 a 67 días tienen tasa de éxito menor que el resto de grupos.

A continuación, se repican algunas gráficas del artículo de referencia.

Distribución acumulada

Estadísticos descriptivos de la duración

summary(df$duracion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     1.0    30.0    30.0    34.2    37.0    92.0
mfv(df$duracion)
## [1] 30
sd(df$duracion)
## [1] 12.79317

CDF por grupo

estado <- "successful"
df.cum  <- df %>% 
  filter(state == estado) %>%
  select(duracion) %>%
  group_by(duracion) %>%
  tally() %>%
  mutate(acumulado = cumsum(n),
         probabilidad = acumulado/sum(n))

plot(df.cum$probabilidad, type = "l", col = "blue",
     ylab = "Probabilidad", xlab = "Duración (días)",
     main = estado, xlim = c(0, 100))

estado <- "failed"
df.cum  <- df %>% 
  filter(state == estado) %>%
  select(duracion) %>%
  group_by(duracion) %>%
  tally() %>%
  mutate(acumulado = cumsum(n),
         probabilidad = acumulado/sum(n))

plot(df.cum$probabilidad, type = "l", col = "blue",
     ylab = "Probabilidad", xlab = "Duración (días)",
     main = estado, xlim = c(0, 100))

estado <- "exceeded goal"
df.cum  <- df %>% 
  filter(usd_pledged_real - usd_goal_real >=0) %>%
  select(duracion) %>%
  group_by(duracion) %>%
  tally() %>%
  mutate(acumulado = cumsum(n),
         probabilidad = acumulado/sum(n))

plot(df.cum$probabilidad, type = "l", col = "blue",
     ylab = "Probabilidad", xlab = "Duración (días)",
     main = estado, xlim = c(0, 100))

estado <- "canceled"
df.cum  <- df %>% 
  filter(state == estado) %>%
  select(duracion) %>%
  group_by(duracion) %>%
  tally() %>%
  mutate(acumulado = cumsum(n),
         probabilidad = acumulado/sum(n))

plot(df.cum$probabilidad, type = "l", col = "blue",
     ylab = "Probabilidad", xlab = "Duración (días)",
     main = estado, xlim = c(0, 100))

Duración (rangos) por estado de campaña

estado <- "successful"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
  data.frame() %>%
  filter(columna == estado) 

fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "failed"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
  data.frame() %>%
  filter(columna == estado) 

fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "canceled"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
  data.frame() %>%
  filter(columna == estado) 

fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "successful"

df %>% 
  filter(state == estado, duracion <= 100) -> fig

hist(fig$duracion, main = estado, 
     ylab = "Número de campañas", 
     xlab = "Duración de la campaña (días)")

estado <- "failed"

df %>% 
  filter(state == estado, duracion <= 100) -> fig

hist(fig$duracion, main = estado, 
     ylab = "Número de campañas", 
     xlab = "Duración de la campaña (días)")

estado <- "canceled"

df %>% 
  filter(state == estado, duracion <= 100) -> fig

hist(fig$duracion, main = estado, 
     ylab = "Número de campañas", 
     xlab = "Duración de la campaña (días)")

Relación entre monto objetivo y éxito de la campaña

¿Cuál es la relación entre el objetivo ($) y el éxito de la campaña?

2.1 Distribución de (monto objetivo y cantidad lograda)

Se agrupa el monto objetivo en los siguientes grupos

df <- df %>%
  arrange(usd_goal_real) %>%
  mutate(rangosGoal = case_when(
    usd_goal_real <= 1000 ~ "G1 [0, 1,000]",
    usd_goal_real <= 10000 ~ "G2 (1,000, 10,000]",
    usd_goal_real <= 100000 ~ "G3 (10,000, 100,000]",
    TRUE ~ "G4 (100,000, ...)"))

Algunos estadísticos:

df %>%
  summarise(Media = mean(usd_goal_real),
            Moda = mfv(usd_goal_real),
            Varianza = var(usd_goal_real),
            sd = sqrt(Varianza),
            Mínimo = min(usd_goal_real),
            Q25 = quantile(usd_goal_real, 0.25),
            Mediana = median(usd_goal_real),
            Q75 = quantile(usd_goal_real, 0.75),
            Máximo = max(usd_goal_real),
            RIC = Q75 - Q25
            ) %>%
  t() -> goal.descriptivos
df.desc <- df %>%
  group_by(rangosGoal) %>%
  summarise(Media = mean(usd_goal_real),
            Moda = mfv(usd_goal_real),
            Varianza = var(usd_goal_real),
            sd = sqrt(Varianza),
            Mínimo = min(usd_goal_real),
            Q25 = quantile(usd_goal_real, 0.25),
            Mediana = median(usd_goal_real),
            Q75 = quantile(usd_goal_real, 0.75),
            Máximo = max(usd_goal_real),
            RIC = Q75 - Q25
            )
## `summarise()` ungrouping output (override with `.groups` argument)
nombres <- t(df.desc[, 1])
df.desc <- data.frame(t(df.desc[-1]))
colnames(df.desc) <- nombres

cbind(df.desc, General =goal.descriptivos) %>%
  round(2) %>%
  kbl() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
G1 [0, 1,000] G2 (1,000, 10,000] G3 (10,000, 100,000] G4 (100,000, …) General
Media 576.13 4826.40 32034.50 998442.2 45455.14
Moda 1000.00 5000.00 15000.00 150000.0 5000.00
Varianza 100999.48 7567929.46 491007482.55 38737895287444.8 1329318373364.47
sd 317.80 2750.99 22158.69 6223977.5 1152960.70
Mínimo 0.01 1000.10 10001.00 100001.0 0.01
Q25 300.00 2500.00 15000.00 150000.0 2000.00
Mediana 501.94 4500.00 25000.00 200771.9 5500.00
Q75 900.00 6926.06 40000.00 400000.0 15500.00
Máximo 1000.00 10000.00 100000.00 166361390.7 166361390.71
RIC 600.00 4426.06 25000.00 250000.0 13500.00

En la siguiente tabla se muestran el monto objetivo promedio por estado; puede observarse que las campañas exitosas tienen tienen, en promedio, un objetivo menor al resto.

df %>%
  group_by(state) %>%
  summarise(Media = mean(usd_goal_real),
            n = n()) 
## `summarise()` ungrouping output (override with `.groups` argument)
## # A tibble: 6 x 3
##   state        Media      n
##   <chr>        <dbl>  <int>
## 1 canceled    75590.  38773
## 2 failed      63175. 197719
## 3 live        62535.   2799
## 4 successful   9533. 133956
## 5 suspended  175302.   1845
## 6 undefined    4103.   3562

Resumen estadístico e histograma de usd_goal_real.

summary(df$usd_goal_real)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##         0      2000      5500     45455     15500 166361391
hist(df$usd_goal_real, main = "Histograma: usd_goal_real",
     xlab = "usd_goal_real", ylab = NULL)

Se descartan los outliers, se elimina al % de los datos extremos

alpha <- 0.01

goal1 <- descarta.outliers(df$usd_goal_real, alpha)
hist(goal1, main = "usd_goal_real sin outliers",
     xlab = "usd_goal_real", ylab = NULL, freq = TRUE)

Una distribución normal no es la mejor elección para modelar el monto objetivo; sin embargo, si se ajusta al logaritmo de los datos.

ggplot(data = df, aes(x = goal1)) +
  geom_histogram(aes(y = ..density.., fill = ..count..)) +
  scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
  stat_function(fun = dnorm, colour = "firebrick", 
                args = list(mean = mean(goal1, na.rm = TRUE),
                            sd = sd(goal1, na.rm = TRUE))) +
  ggtitle(paste("Histograma con curva normal teórica")) +
  theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3778 rows containing non-finite values (stat_bin).

goal1 <-log(goal1)
ggplot(data = df, aes(x = goal1)) +
  geom_histogram(aes(y = ..density.., fill = ..count..)) +
  scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
  stat_function(fun = dnorm, colour = "firebrick", 
                args = list(mean = mean(goal1, na.rm = TRUE),
                            sd = sd(goal1, na.rm = TRUE))) +
  ggtitle(paste("Histograma con curva normal teórica")) +
  theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3778 rows containing non-finite values (stat_bin).

CDF

df <- df %>%
  mutate(goal.alpha = descarta.outliers(usd_goal_real, alpha),
         dif.goal.pledge = usd_goal_real- usd_pledged_real,
         dif.alpha = descarta.outliers(dif.goal.pledge, alpha))
df.CDF <- df %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))
         
fig <- plot_ly(x = ~df.CDF$usd_goal_real, 
               y = df.CDF$CDF, type = 'scatter', mode = 'lines')
rango = "G1 [0, 1,000]"
df.CDF <- df %>%
  filter(rangosGoal == rango) %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))

fig <- plot_ly(df.CDF, x = ~usd_goal_real, 
               y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
  select(rangosGoal, state) %>%
  filter(rangosGoal == rango) %>%
  group_by(state) %>%
  tally() %>%
  mutate(porcentaje = n/sum(n))

fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G2 (1,000, 10,000]"
df.CDF <- df %>%
  filter(rangosGoal == rango) %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))

fig <- plot_ly(df.CDF, x = ~usd_goal_real, 
               y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
  select(rangosGoal, state) %>%
  filter(rangosGoal == rango) %>%
  group_by(state) %>%
  tally() %>%
  mutate(porcentaje = n/sum(n))

fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G3 (10,000, 100,000]"
df.CDF <- df %>%
  filter(rangosGoal == rango) %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))

fig <- plot_ly(df.CDF, x = ~usd_goal_real, 
               y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
  select(rangosGoal, state) %>%
  filter(rangosGoal == rango) %>%
  group_by(state) %>%
  tally() %>%
  mutate(porcentaje = n/sum(n))

fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G4 (100,000, ...)"
df.CDF <- df %>%
  filter(rangosGoal == rango) %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))

fig <- plot_ly(df.CDF, x = ~usd_goal_real, 
               y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
  select(rangosGoal, state) %>%
  filter(rangosGoal == rango) %>%
  group_by(state) %>%
  tally() %>%
  mutate(porcentaje = n/sum(n))

fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig

Diferencia entre monto objetivo y monto logrado

Se calcula la diferencia entre estas variables

ggplot(data = df, aes(x = dif.goal.pledge)) +
  geom_histogram(aes(y = ..density.., fill = ..count..)) +
  scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
  stat_function(fun = dnorm, colour = "firebrick", 
                args = list(mean = mean(df$dif.goal.pledge),
                            sd = sd(df$dif.goal.pledge))) +
  ggtitle(paste("Histograma con curva normal teórica")) +
  theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Descartando outliers:

ggplot(data = df, aes(x = dif.alpha)) +
  geom_histogram(aes(y = ..density.., fill = ..count..)) +
  scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
  stat_function(fun = dnorm, colour = "firebrick", 
                args = list(mean = mean(df$dif.alpha, na.rm = TRUE),
                            sd = sd(df$dif.alpha, na.rm = TRUE))) +
  ggtitle(paste("Histograma con curva normal teórica")) +
  theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3788 rows containing non-finite values (stat_bin).

df.CDF <- df %>%
  select(usd_goal_real) %>%
  arrange(usd_goal_real) %>%
  group_by(usd_goal_real) %>%
  tally() %>%
  mutate(acumulado =  cumsum(n), 
         CDF = acumulado / sum(n))

fig <- plot_ly(df.CDF, x = ~usd_goal_real, 
               y = ~CDF, type = 'scatter', mode = 'lines')
fig

Conclusiones